home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2002 #11 / Amiga Plus CD - 2002 - No. 11.iso / Tools / Development / PowerD / alpha / source / h2m.d < prev    next >
Encoding:
Text File  |  2002-10-28  |  29.9 KB  |  1,242 lines
  1. //
  2. // h2m.d - c include into d ascii module converter by Martin <MarK> Kuchinka (2000-2002)
  3. //
  4. // history:
  5. // 1.0 initial release
  6. //
  7. // 1.1 1.7.2000
  8. //   - added enumerations
  9. //
  10. // 1.2 18.11.2000
  11. //   - '*' doesn't have to be right before the name in structure definition
  12. //
  13. // 1.3 14.1.2001
  14. //   - now the source name can contain the '.h'
  15. //   - now removes the 'xxx_' in 'xxx_yyy' in item names
  16. //   - added recognition for function pointers in structures, requires dc v0.17 or newer
  17. //   - added typedef support, requires dc v0.17 or newer
  18. //
  19. // 1.4 10.2.2001
  20. //   - structs defined by union keyword are now recognised
  21. //
  22. // 1.5 19.6.2001
  23. //   - improved reading of structures
  24. //   - 'short' and 'unsigned xxx' types supported
  25. //
  26. // 1.6 7.7.2001
  27. //   - #if defined(xxx) in now recognized as #ifdef xxx
  28. //   - typedefs as items in structures doesn't freeze anymore (I hope)
  29. //   - typedef like structure supported
  30. //
  31. // 1.7 30.9.2001
  32. //   - removed result typing in function pointers defined in structures
  33. //   - added the #undef support
  34. //
  35. // 1.8 21.1.2002
  36. //   - structs enclosed with it's names are now supported
  37. //
  38. // 1.9 29.5.2002 (reported by Michel Bagmeijer)
  39. //   - fixed conversion: text0x39 was translated to text$39
  40. //   - items in structs now supports mutlidimensional arrays (upto 3d)
  41. //   - added unsigned int type
  42. //
  43. // 1.10 16.8.2002 (reported by Michel Bagmeijer)
  44. //   - small fix in macro reading
  45. //// - enum can now read computed values
  46. //
  47. // todo:
  48. //   - macros inside the structure/typedef
  49. // macro to constant optimizer
  50.  
  51. OPT    OPTIMIZE
  52.  
  53. MODULE    'exec/memory'
  54.  
  55. RAISE    "^C"  IF CtrlC()=TRUE,
  56.         "MEM" IF AllocPooled()=NIL,
  57.         "MEM" IF AllocVecPooled()=NIL
  58.  
  59. ENUM    SOURCE,NOCOMMENT,OPTIMIZE
  60. SET    F_NOCOMMENT,F_OPTIMIZE
  61.  
  62. DEF    pool,flags=0,global:PTR TO data
  63.  
  64. BYTE '\n\n$VER: h2m v1.10 by MarK (\xt \x5d)\n\n\n\0'
  65.  
  66. PROC main()
  67.     DEF    args:PTR TO LONG,ra,
  68.             name[256]:STRING,dest[256]:STRING,
  69.             src:PTR TO CHAR,l,f=NIL,data
  70.     args:=[NIL,FALSE,FALSE]:LONG
  71.     IFN ra:=ReadArgs('SOURCE/A,NC=NOCOMMENT/S,O=OPTIMIZE/S',args,NIL) THEN Raise("DOS")
  72.     IF StrCmp(args[SOURCE]+StrLen(args[SOURCE])-2,'.h')
  73.         StrCopy(name,args[SOURCE])
  74.         StrCopy(dest,args[SOURCE])
  75.         dest[StrLen(dest)-1]:="m"
  76.     ELSE
  77.         StringF(name,'\s.h',args[SOURCE])
  78.         StringF(dest,'\s.m',args[SOURCE])
  79.     ENDIF
  80.     IF args[NOCOMMENT] THEN flags:=F_NOCOMMENT
  81.     IF args[OPTIMIZE] THEN flags|=F_OPTIMIZE
  82.     IF (l:=FileLength(name))<=0 THEN Raise("DOS")
  83.     IFN pool:=CreatePool(MEMF_PUBLIC|MEMF_CLEAR,16384,4096) THEN Raise("MEM")
  84.     src:=AllocVecPooled(pool,l+16)
  85.     IF f:=Open(name,OLDFILE)
  86.         Read(f,src,l)
  87.         Close(f)
  88.         f:=NIL
  89.         global:=data:=ReadC(src,l)
  90.     ELSE Raise("DOS")
  91.     IF flags & F_OPTIMIZE THEN Optimize(data)
  92.     IF f:=Open(dest,NEWFILE)
  93.         WriteD(f,data)
  94.         VFPrintF(f,'\n',NIL)
  95.         Close(f)
  96.         f:=NIL
  97.     ELSE Raise("DOS")
  98. EXCEPTDO
  99.     SELECT exception
  100.     CASE "DOS";    PrintFault(IOErr(),'h2m')
  101.     CASE "MEM";    PrintF('\s: not enough memory\n','h2m')
  102.     CASE "EOF";    PrintF('\s: unexpected eof (\d)\n','h2m',exceptioninfo)
  103.     CASE "^C";    PrintF('\s: ***break \s\n','h2m',exceptioninfo)
  104.     CASE "TYP";    PrintF('\s: unknown type (\d)\n','h2m',exceptioninfo)
  105.     CASE "PTR";    PrintF('\s: too deep pointer (\d)\n','h2m',exceptioninfo)
  106.     CASE "STX";    PrintF('\s: syntax error (\d)\n','h2m',exceptioninfo)
  107.     ENDSELECT
  108.     IF f THEN Close(f)
  109.     IF pool THEN DeletePool(pool)
  110.     IF ra THEN FreeArgs(ra)
  111. ENDPROC
  112.  
  113. OBJECT data
  114.     what:WORD,            // DA...
  115.     next:PTR TO macro
  116.  
  117. ENUM    DA_None,
  118.         DA_Comment,
  119.         DA_OBJECT,        // struct
  120.         DA_STRUCT,        // struct inside an object
  121.         DA_UNION,
  122.         DA_ITEM,
  123.         DA_ENUM,            // enum
  124.         DA_Macro,
  125.         DA_TDEF,            // typedef
  126.         DA_OConst        // constant generated by optimizer
  127.  
  128. OBJECT comment OF data
  129.     comment:PTR TO CHAR
  130.  
  131. OBJECT obj OF data
  132.     name:PTR TO CHAR,
  133.     comment:PTR TO comment,
  134.     item:PTR TO item
  135.  
  136. OBJECT item OF data
  137.     name:PTR TO CHAR,
  138.     comment:PTR TO comment,
  139.     type:UBYTE,                // DT...
  140.     flags:UBYTE,            // IF...
  141.     size:LONG,
  142.     size2:LONG,
  143.     size3:LONG,
  144.     obj:PTR TO CHAR        // obj/NIL
  145.  
  146. OBJECT enum OF data
  147.     first:PTR TO const
  148.  
  149. OBJECT const
  150.     next:PTR TO const,
  151.     name:PTR TO CHAR,
  152.     value:LONG,
  153.     comment:PTR TO comment
  154.  
  155. SET    IF_UNION,                    // item is an UNION
  156.         IF_FUNC
  157.  
  158. ENUM    DT_VOID,                        // cut from dc.e
  159.         DT_LONG,
  160.         DT_ULONG,
  161.         DT_WORD,
  162.         DT_UWORD,
  163.         DT_BYTE,
  164.         DT_UBYTE,
  165.         DT_FLOAT,
  166.         DT_DOUBLE,
  167.         DT_BOOL,
  168.         DT_CUSTOM,                    -> object - global field
  169.         DT_PTR,                        -> VOID pointer
  170.         DT_DLONG,
  171.         DT_UDLONG,
  172.         DT_STRING,
  173.         DT_BASE,
  174.         DT_FUNC,                        // function pointer
  175.         DT_STRUCT                    // typedef structure/object
  176.  
  177. OBJECT macro OF data
  178.     type:WORD,
  179.     name:PTR TO CHAR,
  180.     args:PTR TO CHAR,
  181.     comment:PTR TO CHAR,
  182.     mline:PTR TO mline
  183.  
  184. ENUM    MT_define,
  185.         MT_include,
  186.         MT_ifdef,
  187.         MT_ifndef,
  188.         MT_endif,
  189.         MT_if,
  190.         MT_else,
  191.         MT_undef
  192.  
  193. OBJECT mline
  194.     next:PTR TO mline,
  195.     data:PTR TO CHAR,
  196.     comment:PTR TO CHAR
  197.  
  198. OBJECT typedef OF data
  199.     type:WORD,                        // DT...
  200.     obj:PTR TO CHAR,
  201.     name:PTR TO CHAR,                // new type name
  202.     object:PTR TO obj
  203.  
  204. OBJECT oconst OF data
  205.     name:PTR TO CHAR,
  206.     value:LONG,
  207.     comment:PTR TO comment
  208.  
  209. PROC ReadC(src:PTR TO CHAR,l)(L)
  210.     DEF    last=NIL:PTR TO data,frst=NIL:PTR TO data,pos=0,
  211.             data:PTR TO data,name[80]:CHAR
  212.     WHILE pos<l
  213.         data:=NIL
  214.         pos:=Crop(src,pos,l)
  215.         IF Word(src+pos)="//"||Word(src+pos)="/*"
  216. //        IF (src[pos]="/"&&src[pos+1]="/")||(src[pos]="/"&&src[pos+1]="*")
  217.             pos,data:=Comment(src,pos,l)
  218.         ELSEIF src[pos]="#"
  219.             pos,data:=Macro(src,pos,l)
  220.         ELSE
  221.             pos:=GetName(name,src,pos,l)
  222.             IF StrCmp(name,'struct')
  223.                 pos,data:=OBJECT(src,pos,l)
  224.             ELSEIF StrCmp(name,'union')
  225.                 pos,data:=OBJECT(src,pos,l)
  226.             ELSEIF StrCmp(name,'enum')
  227.                 pos,data:=ENUM(src,pos,l)
  228.             ELSEIF StrCmp(name,'typedef')
  229.                 pos,data:=TYPEDEF(src,pos,l)
  230.             ELSE
  231.                 pos++
  232.             ENDIF
  233.             name[0]:="\0"
  234.         ENDIF
  235.         IFN frst THEN frst:=data
  236.         IF  last THEN last.next:=data
  237.         IF  data THEN last:=data
  238.         WHILE last.next DO last:=.next
  239.         CtrlC()
  240.         IF CtrlD() THEN RETURN frst
  241.     EXITIF src[pos]="\0"
  242.     ENDWHILE
  243. ENDPROC frst
  244.  
  245. // read one or more comments if available
  246. PROC Comment(src:PTR TO CHAR,pos,l)(LONG,PTR TO comment)
  247.     DEF    opos=pos,comment=NIL:PTR TO comment,data:PTR TO CHAR,first=NIL:PTR TO comment,
  248.             last=NIL:PTR TO comment
  249.     WHILE Word(src+pos)="//"
  250.         WHILE src[pos]<>"\n"
  251.             pos++
  252.             CtrlC()
  253.         ENDWHILE
  254.     ELSEWHILE Word(src+pos)="/*"
  255.         REPEAT
  256.             pos++
  257.             CtrlC()
  258.         UNTIL Word(src+pos)="*/"
  259.         pos+=2
  260.     ALWAYS
  261.         IFN flags&F_NOCOMMENT
  262.             comment:=AllocPooled(pool,SIZEOF_comment)
  263.             comment.what:=DA_Comment
  264.             data:=AllocVecPooled(pool,pos-opos+4)
  265.             StrCopy(data,src+opos,pos-opos)
  266.             comment.comment:=data
  267. //            PrintF('(\d) \s\n',opos,data)
  268.             IFN first THEN first:=comment
  269.             IF last THEN last.next:=comment
  270.             last:=comment
  271.         ENDIF
  272. //        pos:=Crop(src,pos,l)
  273.         opos:=pos
  274.     ENDWHILE
  275. ENDPROC pos,first
  276.  
  277. PROC OBJECT(src:PTR TO CHAR,pos,l,etype=FALSE)(LONG,PTR TO obj)
  278.     DEF    name[80]:CHAR,obj:PTR TO obj,next=TRUE,item:PTR TO item,type,objn:PTR TO CHAR,
  279.             last=NIL:PTR TO item,ptr,opos,func,havename=FALSE
  280.     obj:=AllocPooled(pool,SIZEOF_obj)
  281.     obj.what:=DA_OBJECT
  282.     pos:=Skip(src,pos,l)
  283.     IF src[pos]="{"
  284.         pos++
  285.         havename:=FALSE
  286.     ELSE
  287.         pos:=Skip(src,pos,l)
  288.         pos:=GetName(name,src,pos,l)
  289.         obj.name:=AllocPooled(pool,StrLen(name)+4)
  290.         StrCopy(obj.name,name)
  291.         pos:=Crop(src,pos,l)
  292.         pos,obj.comment:=Comment(src,pos,l)
  293.         pos:=Skip(src,pos,l)
  294.         IF src[pos]="{" THEN pos++ //ELSE Raise("STX",pos)
  295.         havename:=TRUE
  296.     ENDIF
  297. //    PrintF('(\d) \s\n',pos,obj.name)
  298.     WHILE next
  299.         opos:=pos:=Skip(src,pos,l)
  300.         pos:=GetName(name,src,pos,l,TRUE)    // read type
  301. //        PrintF('(\d) \s\n',pos,name)
  302.         objn:=NIL
  303.         func:=FALSE
  304.         next:=TRUE
  305.  
  306.         SELECT TRUE
  307.         CASE StrCmp(name,'int'),StrCmp(name,'long'),StrCmp(name,'LONG')
  308.                                                 type:=DT_LONG
  309.         CASE StrCmp(name,'ULONG');        type:=DT_ULONG
  310.         CASE StrCmp(name,'WORD');        type:=DT_WORD
  311.         CASE StrCmp(name,'void');        type:=DT_VOID
  312.         CASE StrCmp(name,'UWORD');        type:=DT_UWORD
  313.         CASE StrCmp(name,'short');        type:=DT_WORD
  314.         CASE StrCmp(name,'BYTE');        type:=DT_BYTE
  315.         CASE StrCmp(name,'UBYTE'),StrCmp(name,'char')
  316.                                                 type:=DT_UBYTE
  317.         CASE StrCmp(name,'STRPTR');    type:=DT_UBYTE|%100000
  318.         CASE StrCmp(name,'float');        type:=DT_FLOAT
  319.         CASE StrCmp(name,'double');    type:=DT_DOUBLE
  320.         CASE StrCmp(name,'short');        type:=DT_WORD
  321.         CASE StrCmp(name,'unsigned long');    type:=DT_ULONG
  322.         CASE StrCmp(name,'unsigned short');    type:=DT_UWORD
  323.         CASE StrCmp(name,'unsigned char');    type:=DT_UBYTE
  324.         CASE StrCmp(name,'unsigned int');    type:=DT_ULONG
  325.         CASE StrCmp(name,'APTR'),StrCmp(name,'BPTR'),StrCmp(name,'CPTR')
  326.                                                 type:=DT_PTR
  327.         CASE StrCmp(name,'struct');    type:=DT_CUSTOM
  328.             pos:=Skip(src,pos,l)
  329.             IF src[pos]="{"
  330.                 pos,item:=OBJECT(src,pos,l,DA_STRUCT)
  331.                 pos:=Skip(src,pos,l)
  332. //                PrintF('(\d) \s\n',pos,item.name)
  333.                 IFN obj.item THEN obj.item:=item
  334.                 IF last THEN last.next:=item
  335.                 last:=item
  336.                 next:=FALSE
  337.             ELSE
  338.                 pos:=GetName(name,src,pos,l)
  339.                 objn:=AllocPooled(pool,StrLen(name)+4)
  340.                 StrCopy(objn,name)
  341.                 pos:=Skip(src,pos,l)
  342. //                PrintF('1(\d) \s\n',pos,item.name)
  343.             ENDIF
  344.         CASE StrCmp(name,'union');        type:=DT_CUSTOM
  345.             pos:=Skip(src,pos,l)
  346.             IF src[pos]="{"
  347.                 pos,item:=OBJECT(src,pos,l,DA_UNION)
  348.                 pos:=Skip(src,pos,l)
  349. //                PrintF('(\d) \s\n',pos,item.name)
  350.                 IFN obj.item THEN obj.item:=item
  351.                 IF last THEN last.next:=item
  352.                 last:=item
  353.                 next:=FALSE
  354.             ELSE
  355.                 pos:=GetName(name,src,pos,l)
  356.                 objn:=AllocPooled(pool,StrLen(name)+4)
  357.                 StrCopy(objn,name)
  358.                 pos:=Skip(src,pos,l)
  359.             ENDIF
  360.         DEFAULT;                                type:=DT_CUSTOM
  361.             objn:=AllocPooled(pool,StrLen(name)+4)
  362.             StrCopy(objn,name)
  363.             pos:=Skip(src,pos,l)
  364. //            Raise("TYP",opos)
  365.         ENDSELECT
  366.  
  367. //        PrintF('type=\d\n',type)
  368.  
  369.         // next is TRUE
  370.         WHILE next
  371.             pos:=Skip(src,pos,l)
  372.             item:=AllocPooled(pool,SIZEOF_item)
  373.             item.what:=DA_ITEM
  374.             item.obj:=objn
  375.             item.type:=type
  376.             IF src[pos]="("
  377.                 func:=TRUE
  378.                 pos:=Skip(src,pos+1,l)
  379.             ENDIF
  380.             ptr:=0
  381.             WHILE src[pos]="*" DO pos++;    ptr++
  382.             pos:=Skip(src,pos,l)
  383.             IF ptr>4 THEN Raise("PTR",pos)
  384.             item.type|=ptr<<5
  385.             pos:=GetName(name,src,pos,l)
  386.             item.name:=AllocPooled(pool,StrLen(name)+4)
  387.             StrCopy(item.name,name)
  388. //            PrintF('(\d) \s(\d)\n',pos,name,ptr)
  389.             pos:=Crop(src,pos,l)
  390.             IF func
  391.                 IF src[pos]=")"
  392.                     pos:=Skip(src,pos+1,l)
  393.                     IF src[pos]="(" THEN pos:=Skip(src,pos+1,l) ELSE Raise("STX",pos)
  394.                     IF src[pos]=")" THEN pos:=Crop(src,pos+1,l) ELSE Raise("STX",pos)
  395.                     item.flags|=IF_FUNC
  396.                 ELSE
  397.                     Raise("STX",pos)
  398.                 ENDIF
  399.             ENDIF
  400. //            PrintF('(\d) \s\n',pos,name)
  401.             IF src[pos]="["
  402.                 opos:=++pos
  403.                 pos:=Find("]",src,pos,l)
  404.                 StrCopy(name,src+opos,pos-opos)
  405.                 C2D(name)
  406.                 item.size:=AllocPooled(pool,StrLen(name)+4)
  407.                 StrCopy(item.size,name)
  408.                 pos++
  409.             ENDIF
  410.             IF src[pos]="["
  411.                 opos:=++pos
  412.                 pos:=Find("]",src,pos,l)
  413.                 StrCopy(name,src+opos,pos-opos)
  414.                 C2D(name)
  415.                 item.size2:=AllocPooled(pool,StrLen(name)+4)
  416.                 StrCopy(item.size2,name)
  417.                 pos++
  418.             ENDIF
  419.             IF src[pos]="["
  420.                 opos:=++pos
  421.                 pos:=Find("]",src,pos,l)
  422.                 StrCopy(name,src+opos,pos-opos)
  423.                 C2D(name)
  424.                 item.size3:=AllocPooled(pool,StrLen(name)+4)
  425.                 StrCopy(item.size3,name)
  426.                 pos++
  427.             ENDIF
  428.             pos:=Crop(src,pos,l)
  429.             IF src[pos]=","
  430.                 next:=TRUE
  431.                 pos++
  432.             ELSE
  433.                 next:=FALSE
  434.             ENDIF
  435.             pos:=Crop(src,pos,l)
  436.             pos,item.comment:=Comment(src,pos,l)
  437.             pos:=Skip(src,pos,l)
  438.             IFN obj.item THEN obj.item:=item
  439.             IF last THEN last.next:=item
  440.             last:=item
  441.             CtrlC()
  442.         ENDWHILE
  443.         CtrlC()
  444.     EXITIF src[pos]="}" DO pos:=Crop(src,pos+1,l)
  445.         next:=TRUE
  446.     ENDWHILE
  447.     IF havename=FALSE
  448.         pos:=Skip(src,pos,l)
  449.         pos:=GetName(name,src,pos,l)
  450. //        PrintF('(\d) \s\n',pos,name)
  451.         obj.name:=AllocPooled(pool,StrLen(name)+4)
  452.         StrCopy(obj.name,name)
  453.         pos:=Crop(src,pos,l)
  454.         pos,obj.comment:=Comment(src,pos,l)
  455.     ENDIF
  456. ENDPROC pos,obj
  457.  
  458. PROC TYPEDEF(src:PTR TO CHAR,pos,l)(LONG,PTR TO typedef)
  459.     DEF    tdef:PTR TO typedef,name[64]:STRING,type,obj=NIL:PTR TO CHAR,object:PTR TO obj
  460.     tdef:=AllocPooled(pool,SIZEOF_typedef)
  461.     tdef.what:=DA_TDEF
  462.     pos:=Skip(src,pos,l)
  463.     pos:=GetName(name,src,pos,l)
  464.     pos:=Skip(src,pos,l)
  465.     SELECT TRUE
  466.     CASE StrCmp(name,'struct')
  467.         pos,object:=OBJECT(src,pos,l,DA_STRUCT)
  468.         object.what:=DA_OBJECT
  469.         type:=DT_STRUCT
  470.         obj:=object.name
  471.         tdef.object:=object
  472. //        PrintF('\s,\d\n',obj,pos)
  473.     CASE StrCmp(name,'int');        type:=DT_LONG
  474.     CASE StrCmp(name,'LONG');        type:=DT_LONG
  475.     CASE StrCmp(name,'ULONG');        type:=DT_ULONG
  476.     CASE StrCmp(name,'float');        type:=DT_FLOAT
  477.     CASE StrCmp(name,'double');    type:=DT_DOUBLE
  478.     CASE StrCmp(name,'short');        type:=DT_WORD
  479.     CASE StrCmp(name,'unsigned long');    type:=DT_ULONG
  480.     CASE StrCmp(name,'unsigned short');    type:=DT_UWORD
  481.     CASE StrCmp(name,'unsigned char');    type:=DT_UBYTE
  482.     DEFAULT;                                type:=DT_CUSTOM
  483.         obj:=AllocPooled(pool,StrLen(name)+4)
  484.         StrCopy(obj,name)
  485.     ENDSELECT
  486.     IF type<>DT_STRUCT
  487.         pos:=GetName(name,src,pos,l)
  488.         pos:=Skip(src,pos,l)
  489.         tdef.name:=AllocPooled(pool,StrLen(name)+4)
  490.         StrCopy(tdef.name,name)
  491.     ENDIF
  492.  
  493.     tdef.type:=type
  494.     tdef.obj:=obj
  495. ENDPROC pos,tdef
  496.  
  497. PROC ENUM(src:PTR TO CHAR,pos,l)(LONG,PTR TO ENUM)
  498.     DEF    enum:PTR TO enum,next=TRUE,const:PTR TO const,prev=NIL:PTR TO const
  499.     DEF    name[256]:STRING,value=0,opos
  500.     enum:=AllocPooled(pool,SIZEOF_enum)
  501.     enum.what:=DA_ENUM
  502.     pos:=Skip(src,pos,l)
  503.     pos:=GetName(name,src,pos,l)
  504.     pos:=Skip(src,pos,l)
  505. //    PrintF('\d=\s\n',pos,name)
  506.     IF src[pos]<>"{" THEN Raise("STX",pos) ELSE pos++
  507.     WHILE next
  508.         value:=NIL
  509.         pos:=Skip(src,pos,l)
  510.         const:=AllocPooled(pool,SIZEOF_const)
  511.         IFN enum.first THEN enum.first:=const
  512.         IF prev THEN prev.next:=const
  513.  
  514.         pos:=GetName(name,src,pos,l)
  515.         const.name:=AllocPooled(pool,StrLen(name)+4)
  516.         StrCopy(const.name,name)
  517.  
  518.         pos:=Skip(src,pos,l)
  519. //        PrintF('1=\d\n',pos)
  520.         IF src[pos]="="
  521. //            pos,value:=GetNum(src,pos+1,l)
  522.  
  523.             opos:=++pos
  524.             pos:=Find(",",src,pos,l)
  525.             StrCopy(name,src+opos,pos-opos)
  526.             C2D(name)
  527.             value:=AllocPooled(pool,StrLen(name)+4)
  528.             StrCopy(value,name)
  529.  
  530.         ENDIF
  531. //        PrintF('2=\d\n',pos)
  532.  
  533.         const.value:=value
  534.  
  535.         pos:=Crop(src,pos,l)
  536.         pos,const.comment:=Comment(src,pos,l)
  537.         pos:=Skip(src,pos,l)
  538. //        PrintF('3=\d\n',pos)
  539.  
  540. //        PrintF('\s=\s\n',const.name,const.value)
  541.  
  542.         IF src[pos]=","
  543.             pos++
  544.         ELSEIF src[pos]="}"
  545.             next:=FALSE
  546.             pos++
  547.         ELSE
  548.             Raise("STX",pos)
  549.         ENDIF
  550.  
  551. //        value++
  552.         prev:=const
  553.     ENDWHILE
  554. ENDPROC pos,enum
  555.  
  556. PROC Macro(src:PTR TO CHAR,pos,l)(LONG,PTR TO macro)
  557.     DEF    opos,macro=NIL:PTR TO macro,name[80]:STRING,next,ml,
  558.             line:PTR TO mline,last:PTR TO mline,buf[1024]:STRING,cpos
  559.     macro:=AllocPooled(pool,SIZEOF_macro)
  560.     macro.what:=DA_Macro
  561.     pos:=Skip(src,pos,l)
  562.     pos:=GetName(name,src,pos,l)
  563.     IF StrCmp(name,'#define')
  564.         macro.type:=MT_define
  565.         pos:=Skip(src,pos,l)
  566.         pos:=GetName(name,src,pos,l)
  567.         macro.name:=AllocPooled(pool,StrLen(name)+4)
  568.         StrCopy(macro.name,name)
  569.         IF src[pos]="("
  570.             opos:=pos
  571.             pos:=Find(")",src,pos,l)
  572.             macro.args:=AllocPooled(pool,pos-opos+4)
  573.             StrCopy(macro.args,src+opos,pos-opos)
  574.         ENDIF
  575.         next:=TRUE
  576.         last:=NIL
  577.         WHILE next
  578.             opos:=pos
  579.             pos:=MaCrop(src,pos,l)
  580.             line:=AllocPooled(pool,SIZEOF_mline)
  581.             StrCopy(buf,src+opos,pos-opos)
  582.             cpos:=C2D(buf)
  583.             ml:=StrLen(buf)+1
  584.             IF cpos<100000 THEN ml-=ml-cpos
  585.             line.data:=AllocPooled(pool,ml+4)
  586.             StrCopy(line.data,buf,ml)
  587. //            PrintF('\s\n',line.data)
  588.             IF src[pos]="\\"
  589.                 pos++
  590.                 next:=TRUE
  591.                 pos:=Crop(src,pos,l)
  592.                 pos,line.comment:=Comment(src,pos,l)
  593.             ELSE
  594.                 next:=FALSE
  595.                 IF cpos<100000 THEN pos,line.comment:=Comment(src,opos+cpos,l)
  596.                 pos++                // skip "\n"
  597.             ENDIF
  598.             IFN macro.mline THEN macro.mline:=line
  599.             IF last THEN last.next:=line
  600.             last:=line
  601.             CtrlC()
  602.         ENDWHILE
  603.     ELSEIF StrCmp(name,'#ifdef')
  604.         macro.type:=MT_ifdef
  605.         pos:=Skip(src,pos,l)
  606.         pos:=GetName(name,src,pos,l)
  607.         macro.name:=AllocPooled(pool,StrLen(name)+4)
  608.         pos:=Skip(src,pos,l)
  609.         StrCopy(macro.name,name)
  610.     ELSEIF StrCmp(name,'#ifndef')
  611.         macro.type:=MT_ifndef
  612.         pos:=Skip(src,pos,l)
  613.         pos:=GetName(name,src,pos,l)
  614.         macro.name:=AllocPooled(pool,StrLen(name)+4)
  615.         StrCopy(macro.name,name)
  616.     ELSEIF StrCmp(name,'#endif')
  617.         macro.type:=MT_endif
  618.     ELSEIF StrCmp(name,'#include')
  619.         macro.type:=MT_include
  620.         pos:=Skip(src,pos,l)
  621.         IF src[pos]="\q"
  622.             opos:=++pos
  623.             WHILE src[pos]<>"\q" DO pos++
  624.             buf[0]:="*"
  625.             StrCopy(buf+1,src+opos,pos-opos)
  626.         ELSEIF src[pos]="<"
  627.             opos:=++pos
  628.             WHILE src[pos]<>">" DO pos++
  629.             StrCopy(buf,src+opos,pos-opos)
  630.         ENDIF
  631.         ml:=StrLen(buf)
  632.         IF buf[ml-2]="."&&buf[ml-1]="h" THEN buf[ml-2]:="\0"
  633.         macro.name:=AllocPooled(pool,ml+4)
  634.         StrCopy(macro.name,buf)
  635.         pos++                // skip "\q" or ">"
  636.     ELSEIF StrCmp(name,'#if')
  637.         macro.type:=MT_if
  638.         pos:=Skip(src,pos,l)
  639.         pos:=GetName(name,src,pos,l)
  640.         IF StrCmp(name,'defined') AND src[pos]="("
  641.             pos:=Skip(src,pos+1,l)
  642.             pos:=GetName(name,src,pos,l)
  643.             pos:=Skip(src,pos,l)
  644.             IF src[pos]<>")" THEN Raise("STX",pos)
  645.             macro.type:=MT_ifdef
  646.         ENDIF
  647.         macro.name:=AllocPooled(pool,StrLen(name)+4)
  648.         pos:=Skip(src,pos,l)
  649.         StrCopy(macro.name,name)
  650.     ELSEIF StrCmp(name,'#undef')
  651.         macro.type:=MT_undef
  652.         pos:=Skip(src,pos,l)
  653.         pos:=GetName(name,src,pos,l)
  654.         macro.name:=AllocPooled(pool,StrLen(name)+4)
  655.         pos:=Skip(src,pos,l)
  656.         StrCopy(macro.name,name)
  657.     ELSEIF StrCmp(name,'#else')
  658.         macro.type:=MT_else
  659.     ENDIF
  660. ENDPROC pos,macro
  661.  
  662. // this function replaces: '->' to '.', '0x' to '$'
  663. PROC C2D(src:PTR TO CHAR)(LONG)
  664.     DEF    spos=0,dpos=0,l=StrLen(src),cpos=100000
  665.     WHILE spos<l        // dpos is always smaller or equal then spos
  666.         IF src[spos]="-"&&src[spos+1]=">"
  667.             src[dpos]:="."
  668.             spos++
  669.         ELSEIF src[spos]="0"&&src[spos+1]="x"
  670.             IFN IsAlpha2Num(src[spos-1])
  671.                 src[dpos]:="$"
  672.                 spos++
  673.             ELSE
  674.                 src[dpos]:=src[spos]
  675.             ENDIF
  676. //        ELSEIF IsHex(src[spos])&&src[spos+1]="L"
  677.         ELSEIF src[spos]>="0"&&src[spos]<="9"&&src[spos+1]="L"
  678.             src[dpos]:=src[spos]
  679.             spos++
  680.         ELSEIF src[spos]>="0"&&src[spos]<="9"&&src[spos+1]="U"&&src[spos+2]="L"
  681.             src[dpos]:=src[spos]
  682.             spos+++
  683.         ELSEIF src[spos]="\q"
  684.             src[dpos]:="\a"
  685.         ELSEIF src[spos]="\a"
  686.             src[dpos]:="\q"
  687.         ELSEIF src[spos]="%"
  688.             src[dpos]:="\\"
  689.         ELSEIF src[spos]="/"&&src[spos+1]="/"
  690.             IF cpos=100000 THEN cpos:=spos
  691.         ELSEIF src[spos]="/"&&src[spos+1]="*"
  692.             IF cpos=100000 THEN cpos:=spos
  693.         ELSE
  694.             src[dpos]:=src[spos]
  695.         ENDIF
  696.         spos++
  697.         dpos++
  698.         CtrlC()
  699.     ENDWHILE
  700.     src[dpos]:="\0"
  701. ENDPROC cpos            // position of comment
  702.  
  703. PROC WriteD(f,data:PTR TO macro)
  704.     DEF    prev
  705.     WHILE data
  706.         prev:=data
  707.         // this loop removes #ifndef and #endif lines from destination
  708.         WHILE data.what=DA_Macro&&data.type=MT_ifndef
  709.             DEF    next=data.next:PTR TO macro
  710.             IF next
  711.                 IF next.what=DA_Macro&&next.type=MT_include
  712.                     IF next.next.what=DA_Macro&&next.next.type=MT_endif
  713.                         WriteMacro(f,next)
  714.                         IF next.next THEN IFN data:=next.next.next THEN RETURN
  715.                     ENDIF
  716.                 ENDIF
  717.             ENDIF
  718.         EXITIF prev=data
  719.         ENDWHILE
  720.         SELECT data.what
  721.         CASE DA_Comment;    WriteComment(f,data)
  722.         CASE DA_OBJECT;    WriteOBJECT(f,data)
  723.         CASE DA_ENUM;        WriteENUM(f,data)
  724.         CASE DA_Macro;        WriteMacro(f,data)
  725.         CASE DA_TDEF;        WriteTDEF(f,data)
  726.         CASE DA_OConst;    data:=WriteCONST(f,data)
  727.         DEFAULT;                PrintF('\d\n',data.what)
  728.         ENDSELECT
  729.         data:=.next
  730.         CtrlC()
  731.     ENDWHILE
  732. ENDPROC
  733.  
  734. PROC WriteComment(f,comment:PTR TO comment)
  735.     FPrintF(f,'\s\n',comment.comment)
  736. ENDPROC
  737.  
  738. PROC WriteOBJECT(f,obj:PTR TO obj,level=0)
  739.     DEF    item:PTR TO item,maxl=0,l
  740.  
  741. //    PrintF('Yeah(\s)\n',obj.name)
  742.  
  743.     item:=obj.item
  744.     ReNameAllItems(item)
  745.  
  746.     // find maximal name length
  747.     WHILE item DO IF (l:=ItemLen(item))>maxl THEN maxl:=l;    item:=.next;    CtrlC()
  748.     IF maxl>80 THEN maxl:=1
  749.  
  750.     IF level>0 THEN FOR l:=1 TO level FPrintF(f,'\t', NIL)
  751.     IF obj.what=DA_OBJECT
  752.         FPrintF(f,'OBJECT \s',obj.name)
  753.         IF obj.comment
  754.             l:=StrLen(item)+3
  755.             WHILE l<maxl DO l++;    FPrintF(f,' ',NIL)
  756.             WriteD(f,obj.comment)
  757.         ELSE
  758.             FPrintF(f,'\n',NIL)
  759.         ENDIF
  760.     ELSEIF obj.what=DA_UNION
  761.         FPrintF(f,'[CUNION\n',obj.name)
  762.     ELSEIF obj.what=DA_STRUCT
  763.         FPrintF(f,'[\n',obj.name)
  764.     ENDIF
  765.  
  766.     item:=obj.item
  767.     WHILE item
  768.         IF item.what=DA_UNION||item.what=DA_STRUCT||item.what=DA_OBJECT
  769.             WriteOBJECT(f,item,level+1)
  770.         ELSE
  771.             FOR l:=0 TO level FPrintF(f,'\t', NIL)
  772.             FPrintF(f,'\s',item.name)
  773.             IF item.flags&IF_FUNC
  774.                 /*IF (item.type&$1f)<>DT_VOID THEN FPrintF(f,'()(\s\s)',TypeStr(item.type-32),item.obj) ELSE*/ VFPrintF(f,'()')
  775.             ELSE
  776.                 IF item.size3
  777.                     FPrintF(f,'[\s,\s,\s]',item.size,item.size2,item.size3)
  778.                 ELSEIF item.size2
  779.                     FPrintF(f,'[\s,\s]',item.size,item.size2)
  780.                 ELSEIF item.size
  781.                     FPrintF(f,'[\s]',item.size)
  782.                 ENDIF
  783.                 FPrintF(f,':\s',TypeStr(item.type))
  784.                 IF item.obj THEN FPrintF(f,item.obj,NIL)
  785.             ENDIF
  786.         ENDIF
  787.         IF item.next THEN FPrintF(f,',',NIL)
  788.         IF item.comment
  789.             l:=ItemLen(item)
  790.             l-=4
  791.             IFN item.next THEN l--
  792.             WHILE l<maxl DO l++;    FPrintF(f,' ',NIL)
  793.             WriteComment(f,item.comment)
  794.         ELSE
  795.             FPrintF(f,'\n',NIL)
  796.         ENDIF
  797.         item:=.next
  798.         CtrlC()
  799.     ENDWHILE
  800.     IF level>0 THEN FOR l:=1 TO level FPrintF(f,'\t', NIL)
  801.     IF obj.what=DA_OBJECT
  802.         IF level>0
  803.             FPrintF(f,'ENDOBJECT',NIL)
  804.         ELSE
  805.             FPrintF(f,'\n',NIL)
  806.         ENDIF
  807.     ELSEIF obj.what=DA_STRUCT
  808.         FPrintF(f,']:\s',obj.name)
  809.     ELSEIF obj.what=DA_UNION
  810.         FPrintF(f,'ENDUNION]:\s',obj.name)
  811.     ENDIF
  812. ENDPROC
  813.  
  814. PROC WriteTDEF(f,tdef:PTR TO typedef)
  815.     IF tdef.type<>DT_STRUCT
  816.         FPrintF(f,'TDEF\t\s:\s',tdef.name,TypeStr(tdef.type))
  817.         IF tdef.obj THEN FPrintF(f,'\s\n',tdef.obj)
  818.         FPrintF(f,'\n',NIL)
  819.     ELSE
  820.         IF tdef.object THEN WriteOBJECT(f,tdef.object)
  821.     ENDIF
  822. ENDPROC
  823.  
  824. PROC ReNameAllItems(first:PTR TO item)
  825.     DEF    pre[16]:CHAR,n=0,len,item=first:PTR TO item
  826.  
  827.     // find the "_" to get the
  828.     len:=StrLen(item.name)
  829.     WHILE item.name[n]<>"_"
  830.         IF n=>len THEN RETURN
  831.         pre[n]:=item.name[n]
  832.         n++
  833.     ENDWHILE
  834.     pre[n++]:="_"
  835.     pre[n]:="\0"
  836.  
  837.     WHILE item
  838.         IF StrCmp(item.name,pre,n)=FALSE THEN RETURN
  839.         item:=.next
  840.     ENDWHILE
  841.  
  842.     item:=first
  843.     WHILE item
  844.         item.name+=n
  845.         item:=.next
  846.     ENDWHILE
  847. ENDPROC
  848.  
  849. PROC WriteENUM(f,enum:PTR TO enum)
  850.     DEF    const:PTR TO const
  851.     const:=enum.first
  852.     FPrintF(f,'ENUM\t',NIL)
  853.     WHILE const
  854.         IF const<>enum.first THEN FPrintF(f,'\t\t',NIL)
  855.         FPrintF(f,'\s',const.name)
  856.         IF const.value
  857.             FPrintF(f,'=\s',const.value)
  858.         ENDIF
  859.         const:=const.next
  860.         IF const THEN FPrintF(f,',',NIL)
  861.         FPrintF(f,'\n',NIL)
  862.         CtrlC()
  863.     ENDWHILE
  864.     FPrintF(f,'\n',NIL)
  865. ENDPROC
  866.  
  867. PROC WriteMacro(f,macro:PTR TO macro)
  868.     SELECT macro.type
  869.     CASE MT_define
  870.         DEF    line:PTR TO mline
  871.         FPrintF(f,'#define \s\s',macro.name,macro.args)
  872.         line:=macro.mline
  873.         WHILE line
  874.             FPrintF(f,' \s',line.data)
  875.             IF line.next THEN FPrintF(f,'\\',NIL)
  876.             IF line.comment
  877.                 FPrintF(f,'\t',NIL)
  878.                 WriteD(f,line.comment)
  879.             ELSE FPrintF(f,'\n',NIL)
  880.             line:=.next
  881.             CtrlC()
  882.         ENDWHILE
  883.     CASE MT_include
  884.         IFN StrCmp(macro.name,'exec/types') THEN FPrintF(f,'MODULE\t''\s''\n',macro.name)
  885.     CASE MT_ifdef
  886.         FPrintF(f,'#ifdef \s\n',macro.name)
  887.     CASE MT_ifndef
  888.         FPrintF(f,'#ifndef \s\n',macro.name)
  889.     CASE MT_endif
  890.         FPrintF(f,'#endif\n',NIL)
  891.     CASE MT_if
  892.         FPrintF(f,'#if \s\n',macro.name)
  893.     CASE MT_undef
  894.         FPrintF(f,'#undefine \s\n',macro.name)
  895.     CASE MT_else
  896.         FPrintF(f,'#else\n',NIL)
  897.     ENDSELECT
  898. ENDPROC
  899.  
  900. PROC WriteCONST(f,const:PTR TO oconst)(PTR TO oconst)
  901.     FPrintF(f,'CONST\t\s=\d',const.name,const.value)
  902.     IF const.next
  903.         IF const.next.what=DA_OConst
  904.             IF const:=.next
  905.                 WHILE const.what=DA_OConst
  906.                     FPrintF(f,',\n\t\t\s=\d',const.name,const.value)
  907.                 EXITIF const.next=NIL
  908.                     const:=.next
  909.                 ENDWHILE
  910.             ENDIF
  911.             FPrintF(f,'\n',NIL)
  912.         ENDIF
  913.     ELSE FPrintF(f,'\n',NIL)
  914. ENDPROC const
  915.  
  916. PROC ItemLen(item:PTR TO item)(L)
  917.     DEF    l,ptr
  918.     l:=IF item.name THEN StrLen(item.name) ELSE 0
  919.     IF item.size THEN l+=StrLen(item.size)+2
  920.     IF item.obj THEN l+=StrLen(item.obj)
  921.     SELECT item.type&$1f                                        // add ':type'
  922.     CASE DT_PTR;                                                l+=4
  923.     CASE DT_LONG,DT_WORD,DT_BYTE,DT_BOOL,DT_VOID;    l+=5
  924.     CASE DT_ULONG,DT_UWORD,DT_UBYTE,DT_FLOAT;            l+=6
  925.     CASE DT_DOUBLE;                                            l+=7
  926.     DEFAULT;                                                        l++
  927.     ENDSELECT
  928.     ptr:=item.type>>5
  929.     l+=ptr*7                    // length of 'PTR TO '
  930. ENDPROC l
  931.  
  932. PROC TypeStr(type)(PTR TO CHAR)
  933.     DEF    str:PTR TO CHAR
  934.     SELECT type
  935.     CASE 1;    str:='LONG'
  936.     CASE 2;    str:='ULONG'
  937.     CASE 3;    str:='WORD'
  938.     CASE 4;    str:='UWORD'
  939.     CASE 5;    str:='BYTE'
  940.     CASE 6;    str:='UBYTE'
  941.     CASE 7;    str:='FLOAT'
  942.     CASE 8;    str:='DOUBLE'
  943.     CASE 9;    str:='BOOL'
  944.     CASE 10;    str:=NIL
  945.     CASE 11;    str:='PTR'
  946.     CASE 12;    str:='DLONG'
  947.     CASE 13;    str:='UDLONG'
  948.     CASE 14;    str:='STRING'
  949.  
  950.     CASE 33;    str:='PTR TO LONG'
  951.     CASE 34;    str:='PTR TO ULONG'
  952.     CASE 35;    str:='PTR TO WORD'
  953.     CASE 36;    str:='PTR TO UWORD'
  954.     CASE 37;    str:='PTR TO BYTE'
  955.     CASE 38;    str:='PTR TO UBYTE'
  956.     CASE 39;    str:='PTR TO FLOAT'
  957.     CASE 40;    str:='PTR TO DOUBLE'
  958.     CASE 41;    str:='PTR TO BOOL'
  959.     CASE 42;    str:='PTR TO '
  960.     CASE 43;    str:='PTR TO PTR'
  961.     CASE 44;    str:='PTR TO DLONG'
  962.     CASE 45;    str:='PTR TO UDLONG'
  963.     CASE 46;    str:='PTR TO CHAR'
  964.  
  965.     CASE 65;    str:='PTR TO PTR TO LONG'
  966.     CASE 66;    str:='PTR TO PTR TO ULONG'
  967.     CASE 67;    str:='PTR TO PTR TO WORD'
  968.     CASE 68;    str:='PTR TO PTR TO UWORD'
  969.     CASE 69;    str:='PTR TO PTR TO BYTE'
  970.     CASE 70;    str:='PTR TO PTR TO UBYTE'
  971.     CASE 71;    str:='PTR TO PTR TO FLOAT'
  972.     CASE 72;    str:='PTR TO PTR TO DOUBLE'
  973.     CASE 73;    str:='PTR TO PTR TO BOOL'
  974.     CASE 74;    str:='PTR TO PTR TO '
  975.     CASE 75;    str:='PTR TO PTR TO PTR'
  976.     CASE 76;    str:='PTR TO PTR TO DLONG'
  977.     CASE 77;    str:='PTR TO PTR TO UDLONG'
  978.     CASE 78;    str:='PTR TO PTR TO CHAR'
  979.  
  980.     CASE 129;str:='LIST OF LONG'
  981.     CASE 130;str:='LIST OF ULONG'
  982.     CASE 131;str:='LIST OF WORD'
  983.     CASE 132;str:='LIST OF UWORD'
  984.     CASE 133;str:='LIST OF BYTE'
  985.     CASE 134;str:='LIST OF UBYTE'
  986.     CASE 135;str:='LIST OF FLOAT'
  987.     CASE 136;str:='LIST OF DOUBLE'
  988.     CASE 137;str:='LIST OF BOOL'
  989.     CASE 138;str:='LIST OF '
  990.     CASE 139;str:='LIST OF PTR'
  991.     CASE 140;str:='LIST OF DLONG'
  992.     CASE 141;str:='LIST OF UDLONG'
  993.     CASE 142;str:='LIST OF CHAR'
  994.     DEFAULT;    str:='VOID'
  995.     ENDSELECT
  996. ENDPROC str
  997.  
  998. PROC GetNum(s:PTR TO CHAR,n=0,l)(LONG,LONG)
  999.     DEF    num=0,sign=1
  1000.     WHILE s[n]="\t" OR s[n]="\n" OR s[n]=" " DO n++
  1001.     IF s[n]="-"
  1002.         sign:=-1
  1003.         n++
  1004.     ENDIF
  1005.     IF s[n]="0" AND s[n+1]="x"                                    // HEXADECIMAL number
  1006.         n+++
  1007.         WHILE s[n]>="0" AND s[n]<="9"
  1008.             num<<=4
  1009.             num|=s[n]-"0"
  1010.         ELSEWHILE s[n]>="a" AND s[n]<="f"
  1011.             num<<=4
  1012.             num|=s[n]-"a"+10
  1013.         ELSEWHILE s[n]>="A" AND s[n]<="F"
  1014.             num<<=4
  1015.             num|=s[n]-"A"+10
  1016.         ALWAYS
  1017.             n++
  1018.             IF n>l THEN Raise("EOF",n)
  1019.         ENDWHILE
  1020.     ELSE                                                                // DECIMAL number
  1021.         WHILE s[n]>="0" AND s[n]<="9"
  1022.             num*=10
  1023.             num+=s[n]-"0"
  1024.             n++
  1025.             IF n>l THEN Raise("EOF",n)
  1026.         ENDWHILE
  1027.     ENDIF
  1028. ENDPROC n,num*sign
  1029.  
  1030. PROC GetName(name:PTR TO CHAR,src:PTR TO CHAR,pos,length,istype=FALSE)(L,PTR)
  1031.     DEF i=0,c=1
  1032.     IF name
  1033.         IF IsAlpha2(src[pos])
  1034.             WHILE c
  1035.                 WHILE IsAlpha2Num(src[pos])
  1036.                     name[i]:=src[pos]
  1037.                     pos++
  1038.                     i++
  1039.                     CtrlC()
  1040.                     IF pos>length THEN Raise("EOF",pos)
  1041.                 ENDWHILE
  1042.                 name[i]:="\0"
  1043.                 c--
  1044.                 IF istype
  1045.                     IF StrCmp(name,'unsigned')
  1046.                         name[i++]:=" "
  1047.                         pos:=Skip(src,pos,length)
  1048.                         c:=1
  1049.                     ENDIF
  1050.                 ENDIF
  1051.             ENDWHILE
  1052.         ENDIF
  1053.     ELSE
  1054.         IF IsAlpha2(src[pos])
  1055.             WHILE IsAlpha2Num(src[pos])
  1056.                 pos++
  1057.                 CtrlC()
  1058.                 IF pos>length THEN Raise("EOF",pos)
  1059.             ENDWHILE
  1060.             name:=TRUE
  1061.         ENDIF
  1062.     ENDIF
  1063. ENDPROC pos,name
  1064.  
  1065. PROC GetString(str:PTR TO CHAR,src:PTR TO CHAR,pos,length)(L,PTR)
  1066.     DEF i=0
  1067.     IF (src[pos]=34)||(src[pos]="<")
  1068.         pos++
  1069.         WHILE (src[pos]<>34)&&(src[pos]<>">")
  1070.             str[i]:=src[pos]
  1071.             pos++
  1072.             i++
  1073.             CtrlC()
  1074.             IF pos>length THEN Raise("EOF",pos)
  1075.         ENDWHILE
  1076.         str[i]:="\0"
  1077.         pos++                // skip ",>
  1078.     ENDIF
  1079. ENDPROC pos,str
  1080.  
  1081. PROC Find(char,src:PTR TO CHAR,pos,length)(L)
  1082.     WHILE src[pos]<>char
  1083.         pos++
  1084.         CtrlC()
  1085.         IF pos>length THEN Raise("EOF",pos)
  1086.     ENDWHILE
  1087. ENDPROC pos
  1088.  
  1089. PROC FindTDEF(item:PTR TO typedef,name:PTR TO CHAR)(BOOL)
  1090.     WHILE item
  1091.         IF item.what=DA_TDEF
  1092.             IF StrCmp(item.name,name) THEN RETURN TRUE
  1093.         ENDIF
  1094.         CtrlC()
  1095.         item:=.next
  1096.     ENDWHILE
  1097. ENDPROC FALSE
  1098.  
  1099. PROC IsAlpha2(char)(L) IS IF ((char>="A")&&(char<="Z"))||((char>="a")&&(char<="z"))||(char="_")||(char="#") THEN TRUE ELSE FALSE
  1100. PROC IsAlpha2Num(char)(L) IS IF ((char>="A")&&(char<="Z"))||((char>="a")&&(char<="z"))||(char="_")||((char>="0")&&(char<="9"))||(char="#") THEN TRUE ELSE FALSE
  1101. PROC IsFirstNum(char)(L) IS IF ((char>="0")&&(char<="9"))||(char=".")||(char="$")||(char="%")||(char="-") THEN TRUE ELSE FALSE
  1102.  
  1103. // skip whitespaces and comments
  1104. PROC Skip(src:PTR TO CHAR,pos,length)(L)
  1105.     DEF done=FALSE,char
  1106.     REPEAT
  1107.         char:=src[pos]
  1108.         IF char=" "
  1109.             pos++
  1110.         ELSEIF char="\t"
  1111.             pos++
  1112.         ELSEIF char=";"
  1113.             pos++
  1114.         ELSEIF char="\n"
  1115.             pos++
  1116.         ELSEIF char="/"
  1117.             IF src[pos+1]="*"
  1118.                 pos++
  1119.                 REPEAT
  1120.                     pos++
  1121.                     IF pos>length THEN RETURN pos
  1122.                 UNTIL (src[pos-1]="*")&&(src[pos]="/")
  1123.                 pos++
  1124.             ELSEIF src[pos+1]="/"
  1125.                 pos++
  1126.                 REPEAT
  1127.                     pos++
  1128.                     IF pos>length THEN RETURN pos
  1129.                 UNTIL (src[pos]="\n")||((src[pos-1]="/")&&(src[pos]="/"))
  1130.                 pos++
  1131.             ELSE
  1132.                 done:=TRUE
  1133.             ENDIF
  1134.         ELSE
  1135.             done:=TRUE
  1136.         ENDIF
  1137.         IF pos>length THEN Raise("EOF",pos)
  1138.     UNTIL done=TRUE
  1139. ENDPROC pos
  1140.  
  1141. // skip whitespaces only
  1142. PROC Crop(src:PTR TO CHAR,pos,length)(L)
  1143.     DEF done=FALSE,char
  1144.     REPEAT
  1145.         char:=src[pos]
  1146.         IF char=" "
  1147.             pos++
  1148.         ELSEIF char="\t"
  1149.             pos++
  1150.         ELSEIF char=";"
  1151.             pos++
  1152.         ELSEIF char="\n"
  1153.             pos++
  1154.         ELSE
  1155.             done:=TRUE
  1156.         ENDIF
  1157.         IF pos>length THEN Raise("EOF",pos)
  1158.     UNTIL done=TRUE
  1159. ENDPROC pos
  1160.  
  1161. PROC MaCrop(src:PTR TO CHAR,pos,length)(L)
  1162.     DEF    cpos=-1,qpos=-1,apos=-1
  1163.     WHILE src[pos]<>"\n"
  1164.         IF src[pos]="/" AND src[pos+1]="/" THEN cpos:=0
  1165.         IF src[pos]="/" AND src[pos+1]="*" THEN cpos:=0
  1166.         IF src[pos]="*" AND src[pos+1]="/" THEN cpos:=-1
  1167.         IF src[pos]="\q" THEN qpos:=~qpos
  1168.         IF src[pos]="\a" THEN apos:=~apos
  1169.         IF src[pos]="\\" THEN IF cpos=-1 AND qpos=-1 AND apos=-1 THEN RETURN pos
  1170.         pos++
  1171.         IF pos>length THEN Raise("EOF",pos)
  1172.     ENDWHILE
  1173. ENDPROC pos
  1174.  
  1175. PROC Optimize(first:PTR TO data)(PTR)
  1176.     DEF    prev=NIL:PTR TO data,data=first:PTR TO data,cnst:PTR TO oconst
  1177.     DEF    macro:PTR TO macro,mline:PTR TO mline,bool:BOOL,flt:BOOL,value
  1178.  
  1179.     // change all number-only macros to constants
  1180.     WHILE data
  1181.         IF data.what=DA_Macro
  1182.             macro:=data
  1183.             IF macro.type=MT_define && macro.args=NIL
  1184.                 IF mline:=macro.mline
  1185.                     IF mline.next=NIL
  1186.                         IF bool,flt:=CheckNumber(mline.data)
  1187.                             IFN flt
  1188.                                 cnst:=AllocPooled(pool,SIZEOF_oconst)
  1189.                                 cnst.what:=DA_OConst
  1190.                                 cnst.next:=data.next
  1191.                                 cnst.name:=macro.name
  1192.                                 value:=Val(mline.data)
  1193.                                 cnst.value:=value
  1194.                                 cnst.comment:=mline.comment
  1195.                                 IF prev THEN prev.next:=cnst ELSE first:=cnst
  1196.                                 data:=cnst
  1197.                             ENDIF
  1198.                         ENDIF
  1199.                     ENDIF
  1200.                 ENDIF
  1201.             ENDIF
  1202.         ENDIF
  1203.         prev:=data
  1204.         data:=.next
  1205.         CtrlC()
  1206.     ENDWHILE
  1207. ENDPROC first
  1208.  
  1209. PROC CheckNumber(str:PTR TO CHAR)(BOOL,BOOL)
  1210.     DEF    number=TRUE:BOOL,n=0,float=FALSE:BOOL
  1211.     n:=Crop(str,0,StrLen(str))
  1212.     IF IsFirstNum(str[n])
  1213.         n++
  1214.         WHILE str[n]
  1215.             IF IsHex(str[n])
  1216.             ELSEIF str[n]=".";    float:=TRUE
  1217.             ELSE number:=FALSE
  1218.             n++
  1219.         ENDWHILE
  1220.     ELSE number:=FALSE
  1221. ENDPROC number,float
  1222.  
  1223. PROC ComputeMacro(first:PTR TO data,macro:PTR TO macro)
  1224.     DEF    line:PTR TO mline,name[64]:STRING,pos,len,npos
  1225.     DEF    value
  1226.     line:=macro.mline
  1227.     WHILE line
  1228.         pos:=0
  1229.         len:=StrLen(line.data)
  1230. //        pos:=Crop(line.data,pos,len)
  1231.         value:=0
  1232.         WHILE (npos:=GetName(name,line.data,pos,len))>pos
  1233.             SELECT TRUE
  1234.             CASE StrCmp(name,'TAG_USER');    value|=$80000000
  1235.             DEFAULT
  1236.             ENDSELECT
  1237.         ENDWHILE
  1238.         line:=.next
  1239.         CtrlC()
  1240.     ENDWHILE
  1241. ENDPROC
  1242.